home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PINBSRC.ZIP / INTRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-02  |  9.6 KB  |  294 lines
  1. { INTRO.PAS   - (c) Ansgar Scherp, Joachim Gelhaus
  2.   All rights reserved / vt'95}
  3.  
  4. {$M 65000,0,250000}
  5. {$A-,T-,P-,Q-,R-}
  6. uses dos,crt,audiotpu;
  7.  
  8. const N1 = ' PCS-PINBALL  - Version 1.1 written by A.Scherp and J.Gelhaus ';
  9.       N2 = ' (c)opyrights reserved by PC Spiel and vIRTUAL tECHNOLOGIES GbR';
  10.  
  11. var
  12.   cd_lw : Char;
  13.   cd_name : string;
  14.   cd_iso : boolean;
  15.   act_lw : Char;
  16.   path : string;
  17.   ch   : char;
  18.   chs  : string[20];
  19.   cd_song:byte;
  20.  
  21. {$I _FLIC.PAS}
  22. {$I _INTEGRI.PAS} {check for integrity // read volumelabel of cd-rom}
  23. {$I _NORMVGA.PAS}
  24.  
  25. const
  26.   NofStars = 50;
  27.   ZFactor = 200;
  28.   Xc = 160;
  29.   Yc = 100;
  30.   Palett : array[0..$2ff] of byte = (
  31. 0,0,0,2,2,2,4,4,4,6,6,6,8,8,8,
  32. 10,10,10,12,12,12,14,14,14,16,16,16,18,18,18,20,
  33. 20,20,22,22,22,24,24,24,26,26,26,28,28,28,30,30,
  34. 30,33,33,33,35,35,35,37,37,37,39,39,39,41,41,41,
  35. 43,43,43,45,45,45,47,47,47,49,49,49,51,51,51,53,
  36. 53,53,55,55,55,57,57,57,59,59,59,61,61,61,63,63,
  37. 63,63,51,51,63,63,51,51,63,51,51,63,63,51,51,63,
  38. 63,51,63,63,39,39,63,51,39,63,63,39,51,63,39,39,
  39. 63,39,39,63,51,39,63,63,39,51,63,39,39,63,51,39,
  40. 63,63,39,63,63,39,51,63,27,27,63,39,27,63,51,27,
  41. 63,63,27,51,63,27,39,63,27,27,63,27,27,63,39,27,
  42. 63,51,27,63,63,27,51,63,27,39,63,27,27,63,39,27,
  43. 63,51,27,63,63,27,63,63,27,51,63,27,39,63,15,15,
  44. 63,27,15,63,39,15,63,51,15,63,63,15,51,63,15,39,
  45. 63,15,27,63,15,15,63,15,15,63,27,15,63,39,15,63,
  46. 51,15,63,63,15,51,63,15,39,63,15,27,63,15,15,63,
  47. 27,15,63,39,15,63,51,15,63,63,15,63,63,15,51,63,
  48. 15,39,63,15,27,63,3,15,63,3,3,63,15,3,63,27,
  49. 3,63,39,3,63,51,3,63,63,3,51,63,3,39,63,3,
  50. 27,63,3,15,63,3,3,63,3,3,63,15,3,63,27,3,
  51. 63,39,3,63,51,3,63,63,3,51,63,3,39,63,3,27,
  52. 63,3,15,63,3,3,63,15,3,63,27,3,63,39,3,63,
  53. 51,3,63,63,3,63,63,3,51,63,3,39,63,3,27,51,
  54. 3,15,51,3,3,51,15,3,51,27,3,51,39,3,51,51,
  55. 3,39,51,3,27,51,3,15,51,3,3,51,3,3,51,15,
  56. 3,51,27,3,51,39,3,51,51,3,39,51,3,27,51,3,
  57. 15,51,3,3,51,15,3,51,27,3,51,39,3,51,51,3,
  58. 51,51,3,39,51,3,27,39,3,15,39,3,3,39,15,3,
  59. 39,27,3,39,39,3,27,39,3,15,39,3,3,39,3,3,
  60. 39,15,3,39,27,3,39,39,3,27,39,3,15,39,3,3,
  61. 39,15,3,39,27,3,39,39,3,39,39,3,27,27,3,15,
  62. 27,3,3,27,15,3,27,27,3,15,27,3,3,27,3,3,
  63. 27,15,3,27,27,3,15,27,3,3,27,15,3,27,27,3,
  64. 27,15,3,3,15,15,3,3,15,3,3,15,15,3,3,15,
  65. 15,3,15,27,15,15,27,27,15,15,27,15,15,27,27,15,
  66. 15,27,27,15,27,39,15,15,39,27,15,39,39,15,27,39,
  67. 15,15,39,15,15,39,27,15,39,39,15,27,39,15,15,39,
  68. 27,15,39,39,15,39,39,15,27,51,15,15,51,27,15,51,
  69. 39,15,51,51,15,39,51,15,27,51,15,15,51,15,15,51,
  70. 27,15,51,39,15,51,51,15,39,51,15,27,51,15,15,51,
  71. 27,15,51,39,15,51,51,15,51,51,15,39,51,15,27,51,
  72. 27,27,51,39,27,51,51,27,39,51,27,27,51,27,27,51,
  73. 39,27,51,51,27,39,51,27,27,51,39,27,51,51,27,51,
  74. 51,27,39,51,39,39,51,51,39,39,51,39,39,51,51,39,
  75. 39,51,51,39,51,39,27,27,39,39,27,27,39,27,27,39,
  76. 39,27,27,39,39,27,39,3,3,3,15,15,15,27,27,27,
  77. 39,39,39,51,51,51,63,63,63,63,22,3,39,7,5,36,
  78. 36,63,0,0,0,22,22,22,38,38,38,52,52,52,63,0,0);
  79.  
  80. type
  81.   StarRec = record
  82.               X,Y,Z : integer;
  83.             end;
  84.   StarPos = array[0..NofStars] of StarRec;
  85.   StarSpd = array[0..NofStars] of word;
  86.  
  87. var
  88.   Stars : StarPos;
  89.   Speed : StarSpd;
  90.   i,x,mfm : word;
  91. var  OldHeapLimit: pointer;
  92.      OldHeapSize : Longint;
  93.  
  94. function FileExists(FileName: String): Boolean;
  95. var
  96.   F: file;
  97. begin
  98.   {$I-}
  99.   Assign(F, FileName);
  100.   Reset(F);
  101.   Close(F);
  102.   {$I+}
  103.   FileExists := (IOResult = 0) and (FileName <> '');
  104. end;  { FileExists }
  105.  
  106.  
  107. procedure init_all;
  108. Begin
  109.   mfm:=filemode;
  110.   filemode:=0;
  111.   {allocate memory}
  112.   OldHeapSize := memavail;
  113.   mark(OldHeapLimit);
  114.   if MaxAvail<BUFFERSIZE then   { check if there is enough memory to the frame
  115.   buffer }
  116.   begin
  117.     WriteLn('ERROR! Can not allocate enough memory to a frame buffer.');
  118.     Halt(0);
  119.   end;
  120. end;
  121.  
  122. procedure Close_all;
  123. begin
  124.   {release memory}
  125.   Release(OldHeapLimit);
  126.   if OldHeapSize <> memavail then begin
  127.       writeln('Attention: Heapmanipulations failed!');
  128.       repeat until keypressed;
  129.     end;
  130.   filemode:=mfm;
  131. end;
  132.  
  133. procedure Init_Star;
  134.  
  135. var
  136.   Regs : registers;
  137.   C : word;
  138.   I,X,Y : byte;
  139.  
  140. begin
  141.   randomize;                                              { Initialize stars }
  142.   for I := 0 to NofStars do begin
  143.     Stars[I].X := random(100)-50;
  144.     Stars[I].Y := random(100)-50;
  145.     Stars[I].Z := random(900)+200;
  146.     Speed[I] := 0;
  147.   end;
  148.  
  149.   C := 0;                                                      { Set palette }
  150.   for I := 0 to 50 do begin
  151.     port[$3C8] := I;
  152.     port[$3C9] := Palett[C];
  153.     port[$3C9] := Palett[C+1];
  154.     port[$3C9] := Palett[C+2];
  155.     inc(C,3);
  156.   end;
  157. end;
  158.  
  159. procedure DoStars;
  160.  
  161. var
  162.   X,Y : integer;
  163.   I,Color : byte;
  164.  
  165. procedure NewStar(Num : byte);
  166.  
  167. var
  168.   X,Y : integer;
  169.  
  170. begin
  171.   X := Xc+round(Stars[Num].X*Stars[Num].Z/ZFactor);
  172.   Y := Yc+round(Stars[Num].Y*Stars[Num].Z/ZFactor);
  173.   if (X > 0) and (X < 320) and (Y > 0) and (Y < 200) then
  174.     mem[$a000:Y*320+X] := 0;
  175.   Stars[Num].X := random(100)-50;
  176.   Stars[Num].Y := random(100)-50;
  177.   Stars[Num].Z := random(100)+200;
  178. end;
  179.  
  180. begin
  181.     while (port[$3da] and 8) <> 8 do;
  182.     while (port[$3da] and 8) = 8 do;
  183.     for I := 0 to NofStars do begin                                  { Stars }
  184.       X := Xc+round(Stars[I].X*Stars[I].Z/ZFactor);
  185.       Y := Yc+round(Stars[I].Y*Stars[I].Z/ZFactor);
  186.       if mem[$a000:Y*320+X] <= 31 then mem[$a000:Y*320+X] := 0;
  187.       X := Xc+round(Stars[I].X*(Stars[I].Z+Speed[I])/ZFactor);
  188.       Y := Yc+round(Stars[I].Y*(Stars[I].Z+Speed[I])/ZFactor);
  189.       if (X > 0) and (X < 320) and (Y > 0) and (Y < 200) then begin
  190.         Color := 8+(Stars[I].Z div 150);
  191.         if Color > 31 then Color := 31;
  192.         if mem[$a000:Y*320+X] = 0 then mem[$a000:Y*320+X] := Color;
  193.       end else NewStar(I);
  194.       inc(Stars[I].Z,Speed[I]); if Stars[I].Z > 20000 then NewStar(I);
  195.       Speed[I] := (Stars[I].Z div 150)*(5-(abs(Stars[I].X*Stars[I].Y) div 500));
  196.     end;
  197. end;
  198.  
  199. procedure play_flic(flic_startpic, flic_endpic:word);
  200. begin
  201.   if act_lw=cd_lw then flicspeed:=0 else flicspeed:=4;
  202.   if flic_startpic=1 then
  203.   begin
  204.     flicspeed:=flicspeed*CLOCK_SCALE; { convert the flicspeed to number of clock}
  205.     GetMem(Buffer,BUFFERSIZE);
  206.     Assign(InputFile,FileName);
  207.     Reset(InputFile,1);
  208.     BlockRead(InputFile,Header,128);  { read the .FLI main header }
  209.     Frames:=Header[6]+Header[7]*256;  { get the number of frames from the.FLI-header }
  210.     if flicspeed=-1 then                  { if flicspeed is not set by a flicspeed overridethen get it from the .FLI-header }
  211.       flicspeed:=(Header[16]+Integer(Header[17])*256)*CLOCK_SCALE;
  212.     InitClock;  { initialize the System Clock }
  213.     GetBlock(Header,16);  { read the first frame-header }
  214.     FrameSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])))-16;  { calculate framesize }
  215.     SecondPos:=128+16+FrameSize;  { calculate what position to skip to when the FLI is finished and is going to start again - }
  216.                                   { the position = .FLI-header +  first_frame-header + first_framesize }
  217.     Chunks:=Header[6]+Header[7]*256;  { calculate number of chunks in frame }
  218.     GetBlock(Buffer^,FrameSize);  { read the frame into the framebuffer }
  219.     TreatFrame(Buffer,Chunks);  { treat the first frame }
  220.     TimeCounter:=GetClock;  { get the current time }
  221.     FrameNumber:=1;  { we start at the first frame (after the initial frame) }
  222.   end;
  223.   Repeat
  224.     GetBlock(Header,16);  { read frame-header }
  225.     FrameSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])))-16;  { size of frame }
  226.     if (FrameSize<>0) and (flic_startpic<=FrameNumber) then  { sometimes there are no changes from one frame to the}
  227.     begin
  228.       Chunks:=Header[6]+Header[7]*256;  { calculate number of chunks in the frame }
  229.  
  230.       GetBlock(Buffer^,FrameSize);  { read the frame into the framebuffer }
  231.       TreatFrame(Buffer,Chunks);  { treat the frame }
  232.     end;
  233.     NextTime:=TimeCounter+flicspeed;   { calculate the Delay to the next frame }
  234.     While TimeCounter<NextTime do TimeCounter:=GetClock;
  235.     Inc(FrameNumber);  { one frame finished, over to the next one }
  236.   Until (FrameNumber>Frames) or (flic_endpic<=framenumber);  { Repeated Until we come to the last frame}
  237.   if (FrameNumber>Frames) then
  238.   begin
  239.     Close(InputFile);            { be a kind boy and close the File beFore we end the Program }
  240.     FreeMem(Buffer,BUFFERSIZE);  { and free the framebuffer }
  241.   end;
  242. END;
  243.  
  244.   const StartSong = 2;
  245.  
  246. begin
  247.   checkbreak := false;
  248.   asm mov ax,03h; int 10h; end;
  249.   textcolor(white); textbackground(red);
  250.   writeln(' PCS-PINBALL  - Version 2.00a               written by A.Scherp and J.Gelhaus ');
  251.   textcolor(7); textbackground(0);
  252.   init_all;
  253.   if paramcount<>1 then cd_song := StartSong  {play this track}
  254.     else begin chs:=paramstr(1); val(chs,cd_song,i); end;
  255.   CheckCDROM;
  256.   if (cd_song < 1) or (cd_song > MAXtitles) then cd_song := StartSong;
  257.   writeln('CD_SONG: ',cd_song);
  258.  
  259.   chdir('INTRO');
  260.   if (cd_lw<>act_lw) then begin
  261.     if Init_CDAudio<>0 then
  262.     begin
  263.       stop_Audio_1;
  264.       if not Play_Track(cd_song) then begin
  265.         writeln('Attention: No Audio-CD-ROM inserted or wrong Track-Number.');
  266.         writeln('           You will not hear any music!');
  267.         delay(1500);
  268.       end else repeat until Audio_busy<>0;
  269.     end;
  270.   end else begin
  271.     writeln('No CD-Audio');
  272.     delay(1500);
  273.   end;
  274.   delay(2000);
  275.   video_mode($13);
  276.   palette_black;
  277.   FileName:='INTRO1.FIC';
  278.   play_flic(1,102);
  279.   init_star;
  280.   while keypressed do ch:=readkey;
  281.   repeat
  282.     retrace;
  283.     set_rgb_color(0,00,0,0);
  284.     doStars;
  285.   until keypressed;
  286.   while keypressed do ch:=readkey;
  287.   play_flic(102,160);
  288.  
  289.   video_mode(3);
  290.   close_all;
  291.   chdir('..');
  292.   halt(100);
  293. end.
  294.